home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / FFC / SETOBJRF.PRG < prev   
Encoding:
Text File  |  1998-05-26  |  3.7 KB  |  120 lines
  1. * SetObjRf.PRG - Set Object Referece.
  2. *
  3. * Copyright (c) 1997 Microsoft Corp.
  4. * 1 Microsoft Way
  5. * Redmond, WA 98052
  6. *
  7. * Description:
  8. * Set an object reference to a specified property based on a specified class.
  9. * Return new instance of specified class if name is an empty string.
  10.  
  11. LPARAMETERS toObject,tcName,tvClass,tvClassLibrary
  12. LOCAL lcName,lcClass,lcClassLibrary,oObject,lnCount
  13. LOCAL lnObjectRefIndex,lnObjectRefCount,oExistingObject
  14.  
  15. IF TYPE("toObject")#"O" OR ISNULL(toObject)
  16.     RETURN .NULL.
  17. ENDIF
  18. lcName=IIF(TYPE("tcName")=="C",ALLTRIM(tcName),LOWER(SYS(2015)))
  19. oExistingObject=.NULL.
  20. oObject=.NULL.
  21. lcClassLibrary=""
  22. DO CASE
  23.     CASE TYPE("tvClass")=="O"
  24.         oObject=tvClass
  25.         lcClass=LOWER(oObject.Class)
  26.         lcClassLibrary=LOWER(oObject.ClassLibrary)
  27.         IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
  28.                 LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
  29.             toObject.vResult=oExistingObject
  30.             RETURN toObject.vResult
  31.         ENDIF
  32.     CASE EMPTY(tvClass)
  33.         oObject=toObject
  34.         lcClass=LOWER(oObject.Class)
  35.         lcClassLibrary=LOWER(oObject.ClassLibrary)
  36.         IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
  37.                 LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
  38.             toObject.vResult=oExistingObject
  39.             RETURN toObject.vResult
  40.         ENDIF
  41.     OTHERWISE
  42.         lcClass=LOWER(ALLTRIM(tvClass))
  43.         DO CASE
  44.             CASE TYPE("tvClassLibrary")=="O"
  45.                 lcClassLibrary=LOWER(tvClassLibrary.ClassLibrary)
  46.             CASE TYPE("tvClassLibrary")=="C"
  47.                 IF EMPTY(tvClassLibrary)
  48.                     lcClassLibrary=LOWER(toObject.ClassLibrary)
  49.                 ELSE
  50.                     lcClassLibrary=LOWER(ALLTRIM(tvClassLibrary))
  51.                     IF EMPTY(JUSTEXT(lcClassLibrary))
  52.                         lcClassLibrary=LOWER(FORCEEXT(lcClassLibrary,"vcx"))
  53.                     ENDIF
  54.                     llClassLib=(JUSTEXT(lcClassLibrary)=="vcx")
  55.                     IF NOT "\"$lcClassLibrary
  56.                         lcClassLibrary=LOWER(FORCEPATH(lcClassLibrary,JUSTPATH(toObject.ClassLibrary)))
  57.                         IF NOT FILE(lcClassLibrary) AND VERSION(2)#0
  58.                             lcClassLibrary=LOWER(FORCEPATH(lcClassLibrary,HOME()+"ffc\"))
  59.                             IF NOT FILE(lcClassLibrary)
  60.                                 lcClassLibrary=LOWER(FULLPATH(JUSTFNAME(lcClassLibrary)))
  61.                             ENDIF
  62.                         ENDIF
  63.                     ENDIF
  64.                     IF NOT FILE(lcClassLibrary)
  65.                         toObject.vResult=.NULL.
  66.                         RETURN toObject.vResult
  67.                     ENDIF
  68.                 ENDIF
  69.             OTHERWISE
  70.                 lcClassLibrary=""
  71.         ENDCASE
  72.         IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
  73.                 LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
  74.             toObject.vResult=oExistingObject
  75.             RETURN toObject.vResult
  76.         ENDIF
  77.         oObject=NEWOBJECT(lcClass,lcClassLibrary)
  78.         IF TYPE("oObject")#"O" OR ISNULL(oObject)
  79.             toObject.vResult=.NULL.
  80.             RETURN toObject.vResult
  81.         ENDIF
  82. ENDCASE
  83. DO CASE
  84.     CASE EMPTY(lcName)
  85.         toObject.vResult=oObject
  86.         RETURN toObject.vResult
  87.     OTHERWISE
  88.         IF NOT toObject.AddProperty(lcName,oObject)
  89.             oObject=.NULL.
  90.         ENDIF
  91. ENDCASE
  92. IF ISNULL(oObject)
  93.     toObject.vResult=.NULL.
  94.     RETURN toObject.vResult
  95. ENDIF
  96. IF PEMSTATUS(oObject,"oHost",5)
  97.     oObject.oHost=toObject.oHost
  98. ELSE
  99.     oObject.AddProperty("oHost",toObject.oHost)
  100. ENDIF
  101. IF EMPTY(lcClassLibrary)
  102.     lcClassLibrary=LOWER(oObject.ClassLibrary)
  103. ENDIF
  104. lnObjectRefCount=toObject.nObjectRefCount
  105. lnObjectRefIndex=lnObjectRefCount+1
  106. FOR lnCount = 1 TO lnObjectRefCount
  107.     IF toObject.aObjectRefs[lnCount,1]==LOWER(lcName)
  108.         lnObjectRefIndex=lnCount
  109.         EXIT
  110.     ENDIF
  111. ENDFOR
  112. IF lnObjectRefIndex>lnObjectRefCount
  113.     DIMENSION toObject.aObjectRefs[lnObjectRefIndex,3]
  114. ENDIF
  115. toObject.aObjectRefs[lnObjectRefIndex,1]=LOWER(lcName)
  116. toObject.aObjectRefs[lnObjectRefIndex,2]=lcClass
  117. toObject.aObjectRefs[lnObjectRefIndex,3]=lcClassLibrary
  118. toObject.vResult=oObject
  119. RETURN toObject.vResult
  120.